The CICA Windows Explosion!/The CICA Windows Explosion! - Disc 2.iso/programr/spmate13.zip/SPELMATE.BA$/spelmate.bas

BASIC Source File | 1993-11-18 | 5KB | 147 lines

Option Explicit

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++
'                                                      +
' SpelChek.BAS.   (c) A.McMonnies/MEDC, 1993.          +
' +++++++++++++++++++++++++++++++++++++++++++          +
' This is a small library demonstrating the use of the +
' seriously cool SPELLMATE spell checker library       +
' from James Heron's Acrian Software Products.         +
' It includes Visual Basic declarations of the SPELMATE+
' library functions, a declaration for IsCharAlpha from+
' the Windows User.DLL library (very useful) and some  +
' small functions which help to parse strings of text  +
' for spell checking.                                  +
' The module can be used to do a simple parse of       +
' strings of text, or to include a spell check.        +
' To check spelling, call SetSpellOn from your program +
' (which should incorporate this module in the Project +
' file), and then call DoSpellCheck(), passing the     +
' string to be examined as a parameter.  e.g......               +
'                                                      +
'   Dim s$                                             +
'      s$ = "Check the spelling of the word speling."  +
'      SetSpellOn                                      +
'      Parse(s$)                                       +
'                                                      +
' If you do not need to check spelling, do not use     +
' SetSpellOn, or call SetSpellOff to disable checking. +
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++

' Alphanumeric id function...
Declare Function IsCharAlpha% Lib "User" (ByVal cChar%)

' Spellmate functions...
Declare Function SpelMateInit Lib "spelmate.dll" () As Integer
Declare Function SpellCheck Lib "spelmate.dll" (ByVal AWord As String) As Integer
Declare Function AddWord Lib "spelmate.dll" (ByVal AWord As String) As Integer
Declare Sub IgnoreWord Lib "spelmate.dll" (ByVal AWord As String)
Declare Sub SuggestVBWord Lib "spelmate.dll" (ByVal AWord As String)
Declare Sub SuggestModalVBWord Lib "spelmate.dll" (ByVal AHandle As Integer, ByVal AWord As String)

Sub DoSpellCheck (T As TextBox)
' Reduce input text to a list of unique text strings
' and check the spelling of each.
Dim Wd$, W As String * 20, ok%, ip%
Dim Start%
    ok% = SpelMateInit()
    If Not ok% Then
        MsgBox "Spellmate has not initialised.", 0, "Spell Check"
        Exit Sub
    End If
    If Len((T.Text)) > 0 Then
        Start% = T.SelStart
    Else
        Exit Sub
        MsgBox "No text to check.", 0, "Spell Check"
    End If
    Do
        Wd$ = Trim$(GetWord$((T.Text), Start%))
        If Wd$ = "" Then
            T.SelLength = 0
            T.SelStart = Len((T.Text))
            Exit Do  ' No more words.
        Else
            ' Set select area to highlight word...
            T.SetFocus
            T.SelStart = Start% - 1
            T.SelLength = Len(Wd$)
            ' Now check it's spelling...
            W = Wd$ & Chr$(0)
            ok% = SpellCheck(Wd$)
            If ok% = 0 Then
                SuggestModalVBWord Form1.hWnd, W
                If Asc(Left$(W, 1)) = 0 Then
                    Exit Do  ' A NULL
                End If
                ip% = InStr(W, Chr$(0))
                If (ip% > 0) And (Wd$ <> Left$(W, ip% - 1)) Then
                    Wd$ = Left$(W, ip% - 1)
                    T.SelText = Wd$
                End If
            End If
        Start% = Start% + Len(Wd$)
        End If
    Loop
End Sub

Function GetWord$ (InText$, StartPos%)
' Function returns the next word in InText$, starting at
' StartPos%, or "" if StartPos% is past last word.
Dim L%, WdLen%, c As String * 1, FinPos%
    L% = Len(InText$)
    ' Is InText$ empty, or is StartPos% past it's end?
    If L% = 0 Or StartPos% > L% Then
        GetWord$ = ""
        Exit Function
    End If

    ' Find the start of the next word...
    If StartPos% < 1 Then
        StartPos% = 1
    End If
    Do Until IsCharAlpha%(Asc(Mid$(InText$, StartPos%, 1)))
        StartPos% = StartPos% + 1
        ' Check we've not overrun the end of Intext$...
        If StartPos% > L% Then
            GetWord$ = ""
            Exit Function
        End If
    Loop

    ' We're at the start, find the end...
    FinPos% = StartPos% + 1
    Do While FinPos% <= L%
        If IsWordChar%(Mid$(InText$, FinPos%, 1)) Then
            FinPos% = FinPos% + 1
        Else
            Exit Do
        End If
    Loop
    ' Adjust for a possessive single quote...
    If Mid$(InText, FinPos% - 1, 1) = "'" Then
        FinPos% = FinPos% - 1
    End If
    WdLen% = FinPos% - StartPos%

    ' Now extract the word...
    GetWord$ = Trim$(Mid$(InText$, StartPos%, WdLen%))
    ' StartPos% = FinPos% + 1
End Function

Function IsWordChar% (c$)
Dim r%
    r% = IsCharAlpha%(Asc(c$))
    If r% Then
        IsWordChar% = True
        Exit Function
    Else
        If c$ = "'" Then
            IsWordChar% = True
            Exit Function
        End If
    End If
    IsWordChar% = r%
End Function